unit wvYandexDisc;

interface

uses
  System.Classes, System.Generics.Collections, IdWebDav, IdSSLOpenSSL, IdHTTPHeaderInfo,
    IdComponent;

type
  TwdElement = class
  type
    TType = (tDirectory, tFile);
  private
    FChild: TObjectList<TwdElement>;
    FEType: TType;
    FName: String;
    FHRef: String;
    FSize: Int64;
    FCreationDate: TDateTime;
    FModifiedDate: TDateTime;

    function GetChild: TObjectList<TwdElement>;
    function GetCount: Integer;
    function GetItem(Index: Integer): TwdElement;

    property Child: TObjectList<TwdElement> read GetChild;
  public
    property EType: TType read FEType;
    property Name: String read FName;
    property HRef: String read FHRef;
    property Size: Int64 read FSize;
    property CreationDate: TDateTime read FCreationDate;
    property ModifiedDate: TDateTime read FModifiedDate;
    property Item[Index: Integer]: TwdElement read GetItem; default;
    property Count: Integer read GetCount;

    constructor Create; overload;
    constructor Create(AType: TType; const AName, AHRef: String; const ASize: Int64; const ACreationDate, AModifiedDate: TDateTime); overload;
    destructor Destroy; override;

    procedure Add(AElement: TwdElement);
    procedure Remove(AElement: TwdElement);
    function Extract(AElement: TwdElement): TwdElement;
    procedure Clear;
  end;

  TSpaceInfo = packed record
    Available, Used: Int64;
  end;


  TYandexDisc = class
  private
    FWebDav: TIdWebDav;
    FSSLHandler: TIdSSLIOHandlerSocketOpenSSL;
    FKeepConnection: Boolean;
    FProxy: TIdProxyConnectionInfo;
    FUseProxy: Boolean;

    procedure Connect;
    procedure Disconnect;

    procedure SetKeepConnection(const Value: Boolean);

    procedure DoStatus(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
  public
    property UseProxy: Boolean read FUseProxy write FUseProxy;
    property Proxy: TIdProxyConnectionInfo read FProxy;
    property KeepConnection: Boolean read FKeepConnection write SetKeepConnection;

    constructor Create(const AUsername, APassword: String);
    destructor Destroy; override;

    function SpaceInfo: TSpaceInfo;
    function List(AElement: TwdElement = nil): TwdElement;
    procedure CreateDirectory(const HRef: String);
    procedure Delete(const HRef: String);
    procedure Copy(const Src, Dest: String; AOverWrite: Boolean = True);
    procedure Move(const Src, Dest: String; AOverWrite: Boolean = True);
    procedure Get(const FileName: String; Stream: TStream; const StartPos, EndPos: Int64); overload;
    procedure Get(const FileName: String; Stream: TStream); overload;
    procedure Put(const FileName: String; Stream: TStream);
  end;

implementation

uses
  System.SysUtils, OmniXML, wvGeneralMethods, wvStrings, IdHTTP, IdSocks;

{ TElement }

procedure TwdElement.Add(AElement: TwdElement);
begin
  Child.Add(AElement);
end;

procedure TwdElement.Clear;
begin
  if FChild <> nil then
    FChild.Clear;
end;

constructor TwdElement.Create;
begin
  FChild := nil;
end;

constructor TwdElement.Create(AType: TType; const AName, AHRef: String;
  const ASize: Int64; const ACreationDate, AModifiedDate: TDateTime);
begin
  Create;
  FEType := AType;
  FName := AName;
  FHRef := AHRef;
  FSize := ASize;
  FCreationDate := ACreationDate;
  FModifiedDate := AModifiedDate;
end;

destructor TwdElement.Destroy;
begin
  FChild.Free;
  inherited;
end;

function TwdElement.Extract(AElement: TwdElement): TwdElement;
begin
  result := Child.Extract(AElement);
end;

function TwdElement.GetChild: TObjectList<TwdElement>;
begin
  if FChild = nil then
    FChild := TObjectList<TwdElement>.Create(True);
  result := FChild;
end;

function TwdElement.GetCount: Integer;
begin
  if FChild = nil then
    exit(0);
  result := FChild.Count;
end;

function TwdElement.GetItem(Index: Integer): TwdElement;
begin
  result := Child[Index];
end;

procedure TwdElement.Remove(AElement: TwdElement);
begin
  Child.Remove(AElement);
end;

{ TYandex }

constructor TYandexDisc.Create(const AUsername, APassword: String);
begin
  FWebDav := TIdWebDav.Create(nil);
  FSSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(FWebDav);
  FSSLHandler.TransparentProxy:= TidSocksInfo.Create(FSSLHandler);
//  FSSLHandler.SSLOptions.Method:= TIdSSLVersion.sslvTLSv1_2;

  FWebDav.IOHandler := FSSLHandler;

  FWebDav.URL.Protocol := 'https';
  FWebDav.URL.Host := 'webdav.yandex.ru';
  FWebDav.URL.Port := '443';
  FWebDav.Request.Username := AUsername;
  FWebDav.Request.Password := APassword;
  FWebDav.Request.BasicAuthentication := True;
  FWebDav.HandleRedirects:= True;


  FKeepConnection := False;
  FProxy := TIdProxyConnectionInfo.Create;
  FUseProxy := False;
end;

procedure TYandexDisc.Copy(const Src, Dest: String; AOverWrite: Boolean);
begin
  Connect;
  try
    FWebDav.DAVCopy(StrToURL(Src), StrToURL(Dest), nil, AOverWrite);
  finally
    Disconnect;
  end;
end;

procedure TYandexDisc.CreateDirectory(const HRef: String);
begin
  Connect;
  try
    FWebDav.DAVMakeCollection(StrToURL(HRef));
  finally
    Disconnect;
  end;
end;

procedure TYandexDisc.Delete(const HRef: String);
begin
  Connect;
  try
    FWebDav.DAVDelete(StrToURL(HRef), '');
  finally
    Disconnect;
  end;
end;

destructor TYandexDisc.Destroy;
begin
  FWebDav.Free;
//  FSSLHandler.Free;
  FProxy.Free;
  inherited;
end;

procedure TYandexDisc.Get(const FileName: String; Stream: TStream);
begin
  Connect;
  try
    FWebDav.Request.Range := EmptyStr;
    FWebDav.Get(StrToURL(FileName), Stream);
  finally
    Disconnect;
  end;
end;

procedure TYandexDisc.Get(const FileName: String; Stream: TStream; const StartPos, EndPos: Int64);
begin
  Connect;
  try
    FWebDav.Request.Range := Format('bytes=%d-%d', [StartPos, EndPos]);
    FWebDav.Get(StrToURL(FileName), Stream);
  finally
    Disconnect;
  end;
end;

function TYandexDisc.List(AElement: TwdElement = nil): TwdElement;
var
  root_created: Boolean;
  xml: IXMLDocument;
  response, href, prop: IXMLNode;
  output: TStringStream;
  e_type: TwdElement.TType;
  e_href, e_name: String;
  e_creation_date, e_modified_date: TDateTime;
  e_size: Int64;
  element: TwdElement;
begin
  Connect;
  try
    if AElement = nil then begin
      AElement := TwdElement.Create(tDirectory, '/', '/', 0, 0, 0);
      root_created := True;
    end else begin
      AElement.Clear;
      root_created := False;
    end;
    try
      output := TStringStream.Create;
      try
        FWebDav.DAVPropFind(AElement.HRef, nil, output, '1');
        output.Position := 0;
        xml := CreateXMLDoc;
        if not xml.LoadFromStream(output) then
          raise Exception.Create(sConst.Exceptions[11]);
        try
          for response in xml.DocumentElement.ChildNodes do
            if response.NodeName = 'd:response' then begin
              href := response.FindNode('d:href');
              prop := response.FindNode('d:propstat')
                .FindNode('d:prop');
              if href.Text = '/' then begin
                AElement.FModifiedDate := HTTPDateToDateTime(prop.FindNode('d:getlastmodified').Text);
                AElement.FCreationDate := HTTPDateToDateTime(prop.FindNode('d:creationdate').Text);
                AElement.FName := prop.FindNode('d:displayname').Text;
              end else begin
                if prop.FindNode('d:resourcetype').FindNode('d:collection') <> nil then
                  e_type := tDirectory
                else
                  e_type := tFile;
                e_href := href.Text;
                e_modified_date := HTTPDateToDateTime(prop.FindNode('d:getlastmodified').Text);
                e_size := StrToInt64(prop.FindNode('d:getcontentlength').Text);
                e_name := prop.FindNode('d:displayname').Text;
                e_creation_date := HTTPDateToDateTime(prop.FindNode('d:creationdate').Text);
                element := TwdElement.Create(e_type, e_name, e_href, e_size, e_creation_date, e_modified_date);
                try
                  AElement.Add(element);
                except
                  element.Free;
                  raise;
                end;
              end;
            end;
        except
          raise Exception.Create(sConst.Exceptions[11]);
        end;
        result := AElement;
      finally
        output.Free;
      end;
    except
      if root_created then
        AElement.Free;
      raise;
    end;
  finally
    Disconnect;
  end;
end;

procedure TYandexDisc.Move(const Src, Dest: String; AOverWrite: Boolean);
begin
  Connect;
  try
    FWebDav.DAVMove(StrToURL(Src), StrToURL(Dest), nil, AOverWrite);
  finally
    Disconnect;
  end;
end;

procedure TYandexDisc.Put(const FileName: String; Stream: TStream);
begin
  Connect;
  try
    FWebDav.DAVPut(StrToURL(FileName), Stream, '');
  finally
    Disconnect;
  end;
end;

procedure TYandexDisc.Connect;
begin
  if not FWebDav.Connected then begin
    if FUseProxy then begin
      //FWebDav.HTTPOptions:= FWebDav.HTTPOptions + [hoInProcessAuth];
      FWebDav.ProxyParams.Assign(FProxy);
      with TIdSSLIOHandlerSocketOpenSSL(FWebDav.IOHandler) do begin
        TransparentProxy.Username:= FProxy.ProxyUsername;
        TransparentProxy.Password:= FProxy.ProxyPassword;
        TransparentProxy.Host:= FProxy.ProxyServer;
        TransparentProxy.Port:= FProxy.ProxyPort;
        TidSocksInfo(TransparentProxy).Authentication:= TSocksAuthentication.saNoAuthentication;
        TidSocksInfo(TransparentProxy).Version:=  TSocksVersion.svSocks4A;
        TidSocksInfo(TransparentProxy).OnStatus:= DoStatus;

        TransparentProxy.Enabled:= True;
      end;
    end else begin
      //FWebDav.HTTPOptions:= FWebDav.HTTPOptions - [hoInProcessAuth];
      FWebDav.ProxyParams.Clear;
      FSSLHandler.TransparentProxy.Enabled:= False;
    end;

//    FWebDav.OnProxyAuthorization
    FWebDav.Connect('webdav.yandex.ru', 443);
  end;
end;

procedure TYandexDisc.Disconnect;
begin
  if not FKeepConnection then
    FWebDav.Disconnect;
end;

procedure TYandexDisc.DoStatus(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: string);
begin
  if AStatusText = '' then beep;
end;

procedure TYandexDisc.SetKeepConnection(const Value: Boolean);
begin
  if (not Value) and FWebDav.Connected then
    FWebDav.Disconnect;
  FKeepConnection := Value;
end;

function TYandexDisc.SpaceInfo: TSpaceInfo;
var
  input, output: TStringStream;
  xml: IXMLDocument;
  node: IXMLNode;
begin
  Connect;
  try
    input := TStringStream.Create('<D:propfind xmlns:D="DAV:"><D:prop><D:quota-available-bytes/><D:quota-used-bytes/></D:prop></D:propfind>');
    try
      output := TStringStream.Create;
      try
        FWebDav.DAVPropFind('/', input, output);
        output.Position := 0;
        xml := CreateXMLDoc;
        if not xml.LoadFromStream(output) then
          raise Exception.Create(sConst.Exceptions[11]);
        try
          node := xml.DocumentElement
            .FindNode('d:response')
            .FindNode('d:propstat')
            .FindNode('d:prop');
          result.Available := StrToInt64(node.FindNode('d:quota-available-bytes').Text);
          result.Used := StrToInt64(node.FindNode('d:quota-used-bytes').Text);
        except
          raise Exception.Create(sConst.Exceptions[11]);
        end;
      finally
        output.Free;
      end;
    finally
      input.Free;
    end;
  finally
    Disconnect;
  end;
end;

end.
